home *** CD-ROM | disk | FTP | other *** search
/ Wayzata's Best of Shareware PC/Windows 1 / Wayzata's Best of Shareware for PC-Windows - Release 1 - Wayzata Technology (1993).iso / mac / DOS / PROGRAMG / MAKEDOOR / MAKEDOOR.BAS < prev    next >
BASIC Source File  |  1992-11-02  |  54KB  |  1,609 lines
  1. 3 ' $linesize:125
  2. 4 ' $title: 'MAKEDOOR Copyright 1990 by Steven R. Kling'
  3. 5 '  WARNING !!! DO NOT CHANGE BYPASS OR Remove LINES 3- 50
  4. 6 '  Copyright 1990 by Steven R. Kling, all rights reserved.
  5. 7 '  First Released .....: January 12, 1991
  6. 8 '  Purpose.............:
  7. 9 '     MAKEDOOR has been written to provide BASIC programmers 
  8. 10 '    within the BBS community with (hopefully) a good quality door example.
  9. 11 '    MAKEDOOR will meet the author's expectation IF:  a journeyman level
  10. 12 '    BASIC programmer can read the MAKEDOOR.BAS source, and THEN: 
  11. 13 '    create a professional quality working door.
  12. 14 '                                                                         
  13. 15 ' *******************************NOTICE*************************************
  14. 16 ' *  A limited license is granted to all users of this program             *
  15. 17 ' *  and its companion documentation on the following conditions:          *
  16. 18 ' *                                                                        *
  17. 19 ' *                                                                        *
  18. 20 ' *    1.   The notices contained in lines 3 through 73 of the program     *
  19. 21 ' *         are not altered, bypassed, or removed.                         *
  20. 22 ' *    2.   The source code, and all documentation to this program         *
  21. 23 ' *         is not to be distributed to others in modified                 *
  22. 24 ' *         form (i.e. the line numbers must remain the same)  without     *
  23. 25 ' *         an express written agreement with Steven R. Kling, Techno-     *
  24. 26 ' *         ware PO BOX 103, Marshall, Virginia, 22115                     *
  25. 27 ' *    3.   No fee is to be charged (or any other consideration received)  *
  26. 28 ' *         for copying or distributing these programs without an express  *
  27. 29 ' *         written agreement with Steven R. Kling at the address noted    *
  28. 30 ' *         in (3) above.                                                  *
  29. 31 ' *    4.   You may freely distribute your programs in .EXE file format    *
  30. 32 ' *         only.  A comment denoting the use of MAKEDOOR would be         *
  31. 33 ' *         appreciated but is not required.                               *
  32. 34 ' *                                                                        *
  33. 35 ' *       Copyright (c) 1990 Steven R. Kling, Technoware                   *
  34. 36 ' **************************************************************************
  35. 37 '
  36. 38 ' Acknowledgements:
  37. 39 ' This program would not be possible if not for the basic idea that
  38. 40 ' users should help other users by sharing their ideas, programs,
  39. 41 ' methods, etc.  RBBS is the greatest example of this sharing of 
  40. 42 ' efforts, and is one of the primary reasons that free BBSes proliferate.
  41. 43 '
  42. 44 ' Many people have helped me learn about Bulletin Boards, and Doors.
  43. 45 ' These people have, in one form or another, shared their ideas, 
  44. 46 ' from which my understanding of this whole process is based.
  45. 47 ' Thanks to:
  46. 48 ' 
  47. 49 ' D. Thomas Mack, Ken Goosens, Jon Martin, and all of the other
  48. 50 ' contributors to RBBS.
  49. 51 '
  50. 52 ' John Morris and Chris Sherrick, the authors of the first great
  51. 53 ' door, Trade Wars (originally released with source code). 
  52. 54 '
  53. 55 ' Fast Fingers (Is F.F. a man or woman?) This person released many
  54. 56 '             ANSI graphics doors, and always freely gave away
  55. 57 '             the code.  I studied these doors to learn some
  56. 58 '             creative methods for door I/O. 
  57. 60 '
  58. 61 ' Phil Dewitt - Phil is the author of many, many doors.  We have
  59. 62 '               worked together on several.  He helped me write
  60. 63 '               my first door.
  61. 64 '
  62. 65 ' Gregg Snyder and all of the other Sysops of the DGS group.
  63. 66 '              This is a group of SYSOPs that are dedicated to
  64. 67 '              helping other with any BBS related projects.  
  65. 68 '              Several of the above mentioned people and I belong to 
  66. 69 '              this group of SYSOPs.  Many innovations in the BBS
  67. 70 '              programs were spawned from someone in this group.
  68. 71 '              Yet, these people will find time to help anyone with
  69. 72 '              a BBS problem.
  70. 73 '
  71. 74 ' ************************* Procedures ******************************
  72. 75 ' 
  73. 76 ' This code is hopefully well documented. This door is divided into
  74. 77 ' 3 parts:
  75. 78 '
  76. 79 '  a.  The Shell.  This is the beginning section, prior to the 
  77. 80 '      line Door.Code.Begins:.  In here you will define all common 
  78. 81 '      variables, subprograms, function`s, and constants.  Otherwise
  79. 82 '      you really shouldn't touch this section until you thoroughly
  80. 83 '      understand the code.
  81. 84 ' 
  82. 85 '  b.  The Door.  This is the section that you will write 100%.
  83. 86 '      and it starts at Door.Code.Begins.  Look at the sample
  84. 87 '      registration door that I have included.  Compile it, 
  85. 88 '      and run it.  Then study the code, and see how it works.
  86. 89 '      I wrote this code for ease of understanding.
  87. 90 '  
  88. 91 '  c.  The rest of the Shell and the Subprograms.  You will need
  89. 92 '      to modify the error trapping section, to support your 
  90. 93 '      requirements.  Also, if you open and close any data files,
  91. 94 '      you will need to write the code in Shutdown to correctly close
  92. 95 '      these.
  93. 96 '
  94. 97 '      FILE NUMBER #1 (as in OPEN #1 for INPUT) is used by the door
  95. 98 '                     for quick file I/O, where a file is opened,
  96. 99 '                     read (or written to), and then closed immediately.
  97. 100'                     This one could be used to read in door datafiles.
  98. 100'
  99. 101'      FILE NUMBER #2 is available for any use.
  100. 102'
  101. 103'      FILE NUMBER #3 is ALWAYS RESERVED for COMMs I/O.  Don't use
  102. 104'      this.  If you were to write a strictly FOSSIL only door,
  103. 105'      and removed all the associate code, then # becomes available.
  104. 106'     
  105. 107'      FILE NUMBER #4 is ALWAYS RESERVE FOR ERROR HANDLING ROUTINES.
  106. 108'
  107. 109'      FILE NUMBERS >= #4 are available for any use.
  108.                              
  109. 110'   Each door must have a MAKEDOOR.DEF file (change the name to something
  110. 111'   specific to your application.  Look at the code for that section.
  111.  
  112. 112'  CAN BE COMPILED UNDER QB4.5 or greater.  BASCOM 7.1 is recommended.
  113. 113'  (BASIC 7.1 PDS is the only BASIC compiler that I will use).
  114. 114'  REQUIRES FOSSCOMM,OBJ and GIVEBK31.OBJ from RBBS to work
  115. 115'
  116. 116'**********************************************************************
  117. 117'  COMPILE COMMAND: (DO NOT LOAD INTO QB or QBX environments!)
  118. 118'
  119. 119'  BC MAKEDOOR.BAS /w/x/c:512/o 
  120. 120'  NOTE: DO NOT USE /S command if you are compiling for others.
  121. 121'  
  122. 122'  LINK COMMAND:
  123. 123'  LINK MAKEDOOR+FOSSCOMM+GIVEBK31;
  124. 124'
  125. 125'  THIS PROGRAM HAS BEEN WRITTEN TO BE BUSTED INTO MODULES
  126.  
  127. ' Here is where you would put all COMMON/SHARED variables,
  128. '       make  constants 
  129. '       declare other variables and dimension arrays                      
  130. COMMON SHARED ARG$, BACK.SP$, BackTab%,BBS.Type$, Bk.Arw$, BC%, BP$, Bytes%
  131. COMMON SHARED C.OLOR(), CR$, CS$, BACKSPACE$, Error.Flag%
  132. COMMON SHARED COL%, COLOR.RESET$, COLOR.NORMAL$, ESC$, ANSI.COMMAND$
  133. COMMON SHARED COM.PORT$, CURSOR$, DataBits%, DOOR.USERS.NAME$, False%
  134. COMMON SHARED FC%, Filename$, FORCESPEED, Fos$, Fossil%
  135. COMMON SHARED GRAPHICS%, GRP%, GRP$, LF$, LFEED, SingleChar%
  136. COMMON SHARED LOG.OFF$, L.ocal%, MESSAGE.FILE$, MSR
  137. COMMON SHARED NORET, NODE, NODE.ID$,Left%,Right%,Up%, Down%
  138. COMMON SHARED Parity%, PAR, PCB14, Port%
  139. COMMON SHARED RD$, RBBS.NAME$, Result%, row%, Scoreboard.File$
  140. COMMON SHARED Security.Level$, Speed%, Stat%, StopBits%
  141. COMMON SHARED SYSOP.FIRST$, SYSOP.LAST$, TabKey%,TABKEY$
  142. COMMON SHARED Snoop,TIME.OFF, TIME.SAVE, True%,TXT$, User.Name$
  143. ' DECLARING THOSE VARIABLES NEEDED FOR THIS SAMPLE DOOR
  144. COMMON SHARED FirstName$, LastName$, Street1$, Street2$
  145. COMMON SHARED Company$, City$, State$,Zipcode$
  146.  
  147.  
  148.  
  149.  
  150. Declare Function TI! ()            ' Keeps track of user time in door
  151. Declare Sub LoadUserRBBSInfo ()    ' Reads DORINFOx.DEF
  152. Declare Sub LoadPCBUserInfo ()     ' Reads PC-Board vers 12 & 14 PCBOARD.SYS
  153. Declare Sub LoadWildcatUserInfo () ' Reads CALLINFO.BBS
  154. Declare Sub PROut ()               ' Most used, Text I/O to Comms and console
  155. Declare Sub PROutCR ()             ' same as above, but with Carriage Return
  156. Declare SUB FsPROut ()             ' Fossil Output through this sub
  157. Declare Sub Cartest ()             ' Monitor Carrier
  158. Declare Sub OutOfTime ()           ' User out of time handling procedure
  159. Declare Sub ShutDown ()            ' Clean and Dirty Door Close Handler
  160. Declare Sub ClrScreen ()           ' Clears screen on users and console screens
  161. Declare Sub ExitDoor ()            ' CLose door and end
  162. Declare Sub InputLine ()           ' Input a normal line of text
  163. Declare Sub InputChar ()           ' Input a single character
  164. Declare Sub InputField (F$)        ' Field Input, supports cursor keys
  165. Declare Sub MoveCursor(r%,c%)      ' Position Cursor
  166. Declare Sub Ansi.Color (F%, B%, BL%, H%, L%) 
  167.                                    ' old routine to change color attributes
  168. Declare Sub Line25 ()              ' Used to Write the Door Legend on Sysop's Line 25
  169. Declare Sub Nam.Adj (N$)           ' Used to Make name the same across BBS types
  170. ' Declare Sub Delay(s%)  This is a sub program found in
  171. '                           the shareware & commercial versions of Probas 
  172. '                           and commented out here.  Get the shareware or
  173. '                           even better, buy the product and then use it.
  174. '                           Delay() delays the input by s% seconds.                                     
  175.  
  176.  
  177. DIM SHARED C.OLOR(32)
  178. RANDOMIZE TIMER
  179. KEY(8) ON
  180. KEY(9) ON
  181. KEY(10) ON
  182. ON KEY(8)  GOSUB Forceoff
  183. ON KEY(9)  GOSUB Snoop
  184. ON KEY(10) GOSUB Chatter
  185. False% = 0
  186. True% = -1
  187. ON ERROR GOTO Err.routine
  188.  
  189. DOOR.NAME$ = "MakeDoor Version 1.0"                        
  190. Row% = 0: Col% = 0
  191. ' This section forces ANSI definitions for colors vice BASIC
  192. C.OLOR(0) = 0   'black
  193. C.OLOR(1) = 4   'red
  194. C.OLOR(2) = 2   'green
  195. C.OLOR(3) = 6   'yellow (brown)
  196. C.OLOR(4) = 1   'blue
  197. C.OLOR(5) = 5   'magenta
  198. C.OLOR(6) = 3   'cyan
  199. C.OLOR(7) = 7   'white
  200. C.OLOR(8) = 8   'grey
  201. C.OLOR(9) = 12  'light red
  202. C.OLOR(10) = 10 'light green
  203. C.OLOR(11) = 14 'yellow
  204. C.OLOR(12) = 9  'light blue
  205. C.OLOR(13) = 13 'light magenta
  206. C.OLOR(14) = 11 'light cyan
  207. C.OLOR(15) = 15 'white
  208. C.OLOR(16) = 16 'black      (blink)
  209. C.OLOR(17) = 20 'red        (blink)
  210. C.OLOR(18) = 18 'green      (blink)
  211. C.OLOR(19) = 22 'yellow     (blink)
  212. C.OLOR(20) = 17 'blue       (blink)
  213. C.OLOR(21) = 21 'magenta    (blink)
  214. C.OLOR(22) = 19 'cyan       (blink)
  215. C.OLOR(23) = 23 'white      (blink)
  216. C.OLOR(24) = 24 'grey       (blink)
  217. C.OLOR(25) = 28 'light red  (blink)
  218. C.OLOR(26) = 26 'lght green (blink)
  219. C.OLOR(27) = 30 'yellow     (blink)
  220. C.OLOR(28) = 25 'light blue (blink)
  221. C.OLOR(29) = 29 'lt magenta (blink)
  222. C.OLOR(30) = 27 'lt cyan    (blink)
  223. C.OLOR(31) = 31 'white      (blink)
  224.  
  225. Empty.Line$ = SPACE$(79)             
  226. FOR.SURE.RBBS = 0
  227.  
  228. 'read command line
  229. RD$ = COMMAND$
  230. PCB14 = FALSE%
  231. ' Check for PC Board flag version 14
  232. IF INSTR(RD$,"/P=14")>0 THEN PCB14 = TRUE%
  233. FORCESPEED=0
  234.  
  235. IF INSTR(RD$,"/C")>0 THEN
  236.   FORCESPEED = 19200
  237.   IF INSTR(RD$,"/C=")>0 THEN
  238.     X$ = MID$(RD$,INSTR(RD$,"/C=")+3,5)
  239.     IF LEN(X$)>0 THEN FORCESPEED = VAL(X$)
  240.   END IF
  241. END IF
  242. RD$ = NODE.ID$
  243.  
  244. 1001         ' ** Read the door's definition file
  245. Filename$ = "MAKEDOOR.DEF"           
  246.  
  247. OPEN "MAKEDOOR.DEF" FOR INPUT AS #1
  248.   ' Look at enclosed MAKEDOOR.DEF
  249.   ' Every door needs to know a little bit about the system on which it is
  250.   ' running.  As everything found herein can either be derived from an
  251.   ' existing file on almost every BBS, or placed on the COMMAND line, 
  252.   ' a Makedoor.def file is not necessary.  This door was written to 
  253.   ' teach, and as Makedoor.def makes life easier this approach was used.
  254.  
  255.   INPUT #1, SYSOP.FIRST$  ' Sysops First Name
  256.   INPUT #1, SYSOP.LAST$   ' Sysops Last Name
  257.   INPUT #1, MESSAGE.FILE$ ' Name of BBS DOOR file
  258.                           ' this makedoor support PCBOARD.SYS
  259.                           ' DORINFOx.DEF, CALLINFO.BBS
  260.   INPUT #1, COM.PORT$     ' COM PORT all Caps with no COLON
  261.                           ' IMPORTANT *****!!!!!*****
  262.                           ' To use FOSSIL routines, append this
  263.                           ' line with /F!! example COM1 /F
  264.  
  265.   INPUT #1, RBBS.NAME$    ' the name of your board
  266.   INPUT #1, LOG.OFF$      ' number of  minutes that the user can 
  267.                           ' be inactive before forced out 
  268.   INPUT #1, MAXTM$        ' max user time in Door
  269.   INPUT #1, Access.Level$ ' Access level required to view door
  270.                           ' Only fully supported in RBBS           
  271.                           '  Look at the code and if you don't understand
  272.                           ' then delete this line, or make the value a 0
  273.   NM.TIME = VAL(MAXTM$)
  274.   Access.level% = VAL(Access.level$)
  275. CLOSE 1
  276.  
  277. 1002                                           
  278. '  Check to see if Fossil is desired          
  279.                                               
  280. IF INSTR(COM.PORT$, "/F") > 0 THEN                 
  281.   Fossil% = True%                                           
  282.   COM.PORT$ = LEFT$(LTRIM$(COM.PORT$), 4)                   
  283.   Port% = VAL(RIGHT$(RTRIM$(COM.PORT$), 1)) - 1             
  284.   IF Port% < 0 THEN L.ocal% = True%                              
  285.   State% = 1
  286.   CALL FosDTR(Port%, State%)            
  287.   CALL FosInit(Port%, Result%)          
  288.   IF Result% = -1 THEN
  289.     Uh.oh$ = "Error initializing Fossil"
  290.     GOTO Write.Err                      
  291.   END IF                                
  292. END IF
  293.  
  294. ' Only COMs 1 & 2 are supported by this Sample door
  295. ' Support for COMs greater than 2 is left to the author
  296.  
  297. IF COM.PORT$ = "COM1" THEN
  298.     ' These values are the are part of the Control Registers
  299.     ' for the serial ports.  Get a good PC book for a further explanation.
  300.     MCR = &H3FC
  301.     MSR = &H3FE
  302.     MPR = &H3FB
  303.   else
  304.     ' COM2
  305.     MCR = &H2FC
  306.     MSR = &H2FE
  307.     MPR = &H2FB
  308. END IF
  309.  
  310. NEXTCASE:
  311. Filename$ = Message.File$
  312. File.ext$ = ucase$(right$(message.file$,3))
  313. select case file.ext$
  314.    case "SYS"
  315.       BBS.Type$ = "PC-Board"
  316.       ' Version 14.0 PCBOARD.SYS
  317.       CALL LoadPCBUserInfo
  318.    case "BBS"
  319.       ' This supports the old version of WILDCAT!'s CALLINFO.BBS file.
  320.       ' I leave it up to the user to update this to use DOOR.SYS or 
  321.       ' WILDCAT!'s other file.
  322.       BBS.Type$ = "Wildcat!"
  323.       CALL LoadWildcatUserInfo
  324.    case "DEF"
  325.       BBS.Type$ = "RBBS"
  326.       CALL LoadRBBSUserInfo
  327.    case else
  328. End Select
  329.  
  330.  
  331.  
  332. FIRST.NAME.END% = INSTR(DOOR.USERS.NAME$, " ")
  333. LAST.NAME.END%  = INSTR(FIRST.NAME.END% + 1, DOOR.USERS.NAME$ + "  ", "  ")
  334.   FIRST$ = LEFT$(DOOR.USERS.NAME$, FIRST.NAME.END% - 1)
  335.   LAST$ = MID$(DOOR.USERS.NAME$, FIRST.NAME.END% + 1, LAST.NAME.END% - (FIRST.NAME.END% + 1))
  336.   USER.NAME$ = FIRST$ + " " + LAST$
  337.   CLOSE 1
  338.   IF FORCESPEED <> 0 AND  Val(BP$) <> 0 THEN
  339.       BP$ = STR$(FORCESPEED)
  340.   END IF
  341.  
  342.   LFEED = 0
  343.  
  344. ' determine parity and number or data and stop bits by examining
  345. '  the Serial Registers
  346.  
  347.   paritycheck% = inp(MPR) and 24
  348.    if paritycheck% = 24 then 
  349.         PAR% =  0
  350.      PAR$ = ",E,7,1,CS,DS,CD"
  351.        IF Fossil% = True% THEN 
  352.          Parity% = 3                               
  353.          DataBits% = 2                             
  354.          StopBits% = 0                           
  355.        END IF
  356.       else
  357.        PAR% = -1
  358.        PAR$ = ",N,8,1,CS,DS,CD"
  359.        IF Fossil% = True% THEN    
  360.          Parity% = 2                               
  361.          DataBits% = 3                             
  362.          StopBits% = 0                             
  363.        end if  
  364.    end if
  365.  
  366.   Sys.Op% = False%
  367.   TIME.SAVE = 5
  368.   Error.Flag% = False%
  369.   CR$  = CHR$(13)
  370.   LF$  = CHR$(10)
  371.   CS$  = CHR$(12)
  372.   ESC$ = CHR$(27)
  373.   ANSI.COMMAND$ = CHR$(91) ' All Ansi commands start with 
  374.                             ' Esc (CHR27 and [ Chr91
  375.   TABKEY$ = CHR$(9)
  376.   Bk.Arw$ = CHR$(29) + " " + CHR$(29)
  377.   BACKSPACE$ = CHR$(8)
  378.   BACK.SP$ = CHR$(8) + " " + CHR$(8)
  379.   COLOR.RESET$ = CHR$(27) + "[00;37;40m"
  380.   COLOR.NORMAL$ = CHR$(27) + "[0m"
  381.   L.ocal% = False%
  382.   IF FIRST$ = "SYSOP" THEN
  383.     Sys.Op% = True%
  384.     IF Fossil% = False% THEN               
  385.       IF INP(MSR) < 128 THEN L.ocal% = True%          
  386.      ELSE                                  
  387.       CALL FosStatus(Port%, Stat%)         
  388.       Stat% = Stat% AND &H0080             
  389.       IF Stat% <> &H0080 THEN L.ocal% = True%   
  390.     END IF                                 
  391.     FIRST$ = SYSOP.FIRST$
  392.     LAST$ = SYSOP.LAST$
  393.     CLOSE 3
  394.   END IF
  395.   Speed% = VAL(BP$)                        
  396.  
  397.   IF VAL(BP$) < 1 THEN L.ocal% = True%
  398.   IF COM.PORT$ = "COM0" THEN
  399.     CLS                                    
  400.     LOCATE 12, 30,1                          
  401.     PRINT "LOCAL WORKSTATION MODE"
  402.     FOR SL = 1 TO 2000
  403.     NEXT SL
  404.     L.ocal% = True%
  405.   END IF
  406.   IF L.ocal% <> True% THEN                           
  407.     IF Fossil% = False% THEN               
  408.       OPEN COM.PORT$ + ":" + BP$ + PAR$ FOR RANDOM AS #3
  409.      ELSE                                  
  410.       Flow% = &H00F2                       
  411.       CALL FosFlowCtl(Port%, Flow%)        
  412.       CALL FosSpeed(Port%, Speed%, Parity%, DataBits%, StopBits%)  
  413.     END IF 
  414.   END IF
  415. GOSUB Indoor
  416.  
  417.  
  418. CALL NAM.ADJ(FIRST$)
  419. CALL NAM.ADJ(LAST$)
  420. ON.AT$ = TIME$
  421. IF (Snoop OR L.ocal% = True%) THEN CALL LINE25
  422.  
  423. GOTO Door.Code.Begins     
  424.  
  425.  
  426. COLORASK:
  427.  
  428. ' This sample door is using the Row% and Col% variables to move the 
  429. ' cursor around the screen.  If this is used, or 
  430. ' if color is desired, then Graphics is REQUIRED.
  431. ' It is left up to the Author to modify this section to suit their 
  432. ' needs
  433.  
  434. IF GRP%=2 THEN RETURN
  435. IF PAR <> -1 THEN RETURN
  436. OLDGRP = GRP%
  437. GRP% = 2
  438. GOSUB INDOOR
  439. FC% = 3
  440. TXT$ = ""
  441. CALL PROUTCR
  442. TXT$ = "Your color selection mode indicates that in the main BBS you prefer plain"
  443. CALL PROUTCR
  444. TXT$ = "ASCII text. Graphics is REQUIRED for this door.  You have to change to color"
  445. CALL PROUTCR
  446. TXT$ = "mode inside this door (affects this door only and this session only)"
  447. CALL PROUTCR
  448. FC% = 4
  449. TXT$ = ""
  450. CALL PROUTCR
  451. high% = 1
  452. TXT$ = "Your system is capable of supporting `color or graphics'  IF this paragraph is"
  453. CALL PROUTCR
  454. high% = 1
  455. TXT$ = "a different color than the last  -- or if the question below blinks."
  456. CALL PROUTCR
  457. TXT$ = ""
  458. CALL PROUTCR
  459. FC% = 7
  460. BLINK% = 1
  461. TXT$ = "      Use Graphics (Y/N)? "
  462. CALL PROUT 
  463. CALL InputLine                                     
  464. TXT$ = LTRIM$(RTRIM$(TXT$))                         
  465. TXT$ = MID$(UCASE$(TXT$),1,1)                      
  466. IF TXT$ = "N"  THEN                                
  467.   call ClrScreen                                   
  468.   TXT$ = "I am sorry, but this door requires that you use graphics." 
  469.   CALL PROUTCR       
  470.   TXT$ = "<Press enter to return to " + rbbs.name$ +" >" 
  471.   CALL PROUTCR
  472.   CALL InputLine
  473.   CALL ShutDown 
  474.  ELSE           
  475.   GRP% = 2 : RETURN                                       
  476. END IF
  477.  
  478. GRP% = OLDGRP
  479. RETURN
  480.  
  481.  
  482. Door.Code.Begins:                  
  483.  
  484. '**********************************************************************
  485. '**********************************************************************
  486. '**********************************************************************
  487. '**********                                                   *********
  488. '**********    This is the start of your door code            *********
  489. '**********                                                   *********
  490. '**********       90% of your coding begins in here!          *********
  491. '**********                                                   *********
  492. '**********                                                   *********
  493. '**********************************************************************
  494. '**********************************************************************
  495.  
  496.      
  497. ' Here is the security level sample.  This can be taken out or modified
  498. ' at the authors discretion 
  499.  
  500.     If access.level% > 0 and  (access.level% > val(security.level$)) then    
  501.          Call ClrScreen                                                      
  502.          TXT$ = "I am sorry, but you don't have the access to view this door."
  503.          call proutcr                              
  504.          '  call delay(2)                              
  505.          CALL ShutDown       
  506.         end if               
  507.  
  508. ' Everything that you send to the screen should go through one of the
  509. ' following subprograms
  510.  
  511. ' ClrScreen - clears the screen
  512.  
  513. ' PROUTCR - This simply prints the string TXT$ with  a carriage
  514. '           return on the end.  If ROW%, COL%, FC%, BC%, HIGH%, or BLINK%
  515. '           are not specified then it prints TXT$ at the current cursor
  516. '           position.
  517. '           Row% and Col% position cursor
  518. '           FC% and BC% are for foreground and background colors
  519. '           HIGH% and BLINK% are to change the intensity and make 
  520. '           the foreground color blink, respectively.
  521.  
  522.   
  523. ' PROUT  - same as above, only with no Carriage return
  524. ' INPUTLINE - This subprogram closely mimics BASIC INPUT command
  525. '             like above,set the colors and cursor
  526. '             Answer is returned to the program in the string ARG$
  527.                
  528. ' INPUTCHAR - This subprogram gets single key input, returns string
  529. '             in ARG$.  Cursor and some other special keys are 
  530. '             checked for.  
  531.  
  532. ' INPUTFIELD(Field$) - Gets user input for a specified field.
  533. '                  has built-in routines to look for 
  534. '                  cursor movement within and between fields.
  535. '                               ****NOTE*****
  536. '                  All fields must be pre-initialized
  537. '                  to their correct length with either spaces or
  538. '                  some other default value, else this subprogram
  539. '                  will generate an error.  This subprogram
  540. '                  is kind of complicated.  I wrote it 
  541. '                  for comprehension, not speed, and should be
  542. '                  rewritten to improve throughput.
  543.               
  544.  
  545. Call ClrScreen
  546.  
  547.  
  548. ' initializing the field variables
  549. FirstName$ = space$(25)
  550. LastName$  = space$(25)
  551. Street1$   = space$(30)
  552. Street2$   = space$(30)
  553. Company$   = space$(40)
  554. City$      = space$(25)
  555. State$     = space$(2)
  556. Zipcode$   = space$(9)
  557.  
  558. EditRecord:
  559.  
  560. row%= 4:col% = 24:TXT$ = "┌───────────────────────────────────┐":CALL PROUT
  561. row%= 5:col% = 24:TXT$ = "│       REGISTRATION DOOR           │":CALL PROUT
  562. row%= 6:col% = 24:TXT$ = "└───────────────────────────────────┘":CALL PROUT
  563. row% = 11:col% =50 : txt$ ="Use left and right cursor":call prout
  564. row% = 12:col% =50 : txt$ ="Cursor keys to move within":call prout
  565. row% = 13:col% =50 : txt$="a field, and the up and down":call prout
  566. row% = 14:col% =50 : txt$="cursors keys to move between ":call prout
  567. row% = 15:col% =50 : txt$="fields.": call prout
  568.  
  569. row% = 10:col% = 5
  570. txt$ = "Enter the following information: ": call prout
  571. row% = 13:col% = 5
  572. txt$ = "First Name  : "+FirstName$:call prout
  573. row% = 14:col% = 5
  574. txt$ = "Last Name   : "+ LastName$:call prout
  575. row% = 15: col% = 5
  576. txt$ = "Street      : "+ Street1$:call prout
  577. row% = 16: col% = 5
  578. txt$ = "Street(cont): "+ Street2$:call prout 
  579. row% = 17:col% = 5
  580. txt$ = "City        : "+ City$:call prout
  581. row% = 17: col% = 45
  582. txt$ = "State : "+State$ : call prout
  583. row% = 17: col% = 58
  584. txt$ = "Zipcode: "+Zipcode$:call prout
  585.  
  586. Field1:
  587. Call MoveCursor(13,19)   
  588. call InputField(FirstName$)
  589.  
  590. Field2:
  591. Call MoveCursor(14,19)
  592. call InputField(LastName$)
  593.  
  594. if BACKTAB% then
  595.    goto field1
  596. end if
  597. Field3:
  598. Call MoveCursor(15,19)   
  599. call inputfield(Street1$)
  600.  
  601. If backtab% then 
  602.    goto field2
  603. end if
  604. Field4:
  605. Call MoveCursor(16,19)
  606. call inputfield(Street2$)
  607. If BackTab% then
  608.    goto Field3
  609. End if
  610.  
  611. Field5:
  612. Call MoveCursor(17,19)
  613. Call InputField(City$)
  614. If BackTab% then
  615.    goto Field4
  616. End if
  617.  
  618. Field6:
  619.  
  620. Call MoveCursor(17,53)
  621. Call InputField(State$)
  622. If BackTab% then
  623.    goto Field5
  624. End IF
  625.  
  626. Field7:
  627. Call MoveCursor(17,67)
  628. Call InputField(Zipcode$)
  629. If BackTab% then 
  630.    Goto Field6
  631. End If
  632. row% = 20:col% = 5
  633. Txt$ = "Are you calling for a business/firm? ":Call Prout
  634. Call InputChar
  635.  
  636. If UCase$(ARG$) = "Y" then
  637.   row% = 18:col% = 5
  638.   txt$ = "Company Name: "+Company$:call prout
  639.   Call MoveCursor(18,19)
  640.   Call InputField(Company$)
  641. End if
  642. makechoice:
  643. row% = 20:col% = 1: txt$ = Empty.Line$:call prout
  644. row% = 20:col% = 21
  645. txt$ = "Please enter (S)ave, (E)dit, or (Q)uit): "
  646. call PROUT:CALL InputChar
  647. if len(arg$) > 0 then  arg$ = Ucase$(arg$)
  648.   
  649. Select case ARG$
  650.  
  651.     Case "S"
  652.         ' In here you need to write the routine that saves the information
  653.         ' to a data file.  This is left to the author.
  654.        
  655.      case "E"
  656.       call ClrScreen
  657.       goto editrecord
  658.     case "Q" 
  659.  
  660.       quitchoice:  
  661.       row% = 21: col% = 5
  662.       Txt$ = "Are you sure you want to quit without saving your entry? "
  663.       Call Prout: call InputChar
  664.       if len(arg$) then arg$ = ucase$(arg$)
  665.       select case arg$
  666.          case "Y"
  667.            call Shutdown
  668.          case "N" 
  669.            row% = 20:col% = 1: txt$ = Empty.Line$:call prout
  670.            row% = 21:col% = 1:txt$ = empty.line$: call prout
  671.            goto makechoice  
  672.          case else
  673.            row% = 21:col% = 1:txt$ = empty.line$: call prout
  674.            goto quitchoice 
  675.       end select 
  676.  
  677.     case else
  678.        goto makechoice
  679.  
  680. End Select
  681.  
  682. Call ClrScreen:Txt$ = "That's All Folks!":call prout
  683. ' call delay(3) 
  684.   CALL ShutDown
  685.  
  686.  
  687. CLOSE
  688. END
  689.  
  690.  
  691. '**********************************************************************
  692. '**********************************************************************
  693. '**********************************************************************
  694. '**********                                                   *********
  695. '**********    This is the main portion of you door           *********
  696. '**********                                                   *********
  697. '**********          code should finish                       *********
  698. '**********                                                   *********
  699. '**********                                                   *********
  700. '**********************************************************************
  701. '**********************************************************************
  702.  
  703.  
  704. Err.routine:                       '** Error routines
  705. 'DEVICE I/O ERROR
  706. Error.Flag% = True%
  707.  
  708. ' the following keeps the door from totally crashing,
  709. ' by recursively calling the error trap routine.
  710. If error.Flag% then
  711.   close
  712.   end
  713. end if
  714.  
  715.  
  716. CLS
  717. PRINT ERR
  718. IF ERR = 57 THEN
  719.     ERROR.FLAG% = fALSE%
  720.     RESUME
  721. END IF
  722. 'check for errors in reading door's DEF file or BBS-specific info
  723. '  (MESSAGES, DORINFOx.DEF, CALLINFO.BBS, PCBOARD.SYS)
  724.  
  725.  
  726. IF ERR = 53 THEN 
  727.  
  728.    select case File.name$
  729.         case Message.file$
  730.            select case BBS.Type$
  731.              case "PC-Board"
  732.                     PRINT"CANNOT FIND PCBoard's FILE: "+MESSAGE.FILE$   
  733.                  case "RBBS"               
  734.                     PRINT "CANNOT FIND RBBS's FILE: " + MESSAGE.FILE$         
  735.                  case "Wildcat!"
  736.                      PRINT "CANNOT FIND Wildcat!'s FILE: " + MESSAGE.FILE$
  737.                  case else
  738.                     PRINT "CANNOT FIND DOOR FILE: " + MESSAGE.FILE$
  739.            end select
  740.                   case else
  741.                     PRINT "CANNOT FIND DOOR FILE: " + File.Name$
  742.    end select
  743.  
  744. END IF
  745. IF ERR = 62 THEN 
  746.    PRINT "THERE'S AN EXTRA LINE IN: " + file.name$
  747.  
  748. END IF
  749. '  many of the most likely errors listed below -- author reponsibility
  750. '  to trap and or take appropriate action -- all such errors in this
  751. '  skeleton code result in abrupt termination of program and a return
  752. '  to the BBS
  753. '
  754. ' ERR = 5 = ILLEGAL FUNCTION CALL
  755. ' ERR = 6 = OVERFLOW
  756. ' ERR = 9 = SUBSCRIPT OUT OF RANGE
  757. ' ERR =11 = DIVISION BY ZERO
  758. ' ERR =24 = DEVICE TIMEOUT
  759. ' ERR =25 = DEVICE FAULT
  760. ' ERR =27 = OUT OF PAPER
  761. ' ERR =52 = BAD FILE NAME OR NUMBER
  762. ' ERR =53 = FILE NOT FOUND
  763. ' ERR =54 = BAD FILE MODE
  764. ' ERR =55 = FILE ALREADY OPEN
  765. ' ERR =57 = DEVICE I/O ERROR
  766. ' ERR =58 = FILE ALREADY EXISTS
  767. ' ERR =70 = PERMISSION DENIED
  768. ' ERR =71 = DISK NOT READY
  769. ' ERR =75 = PATH/FILE ACCESS ERROR
  770. ' ERR =76 = PATH NOT FOUND
  771.  
  772. Write.err:
  773. TXT$ = "Error >" + STR$(ERR) + " File >" + DOOR.NAME$ + " Date >" + DATE$ + " " + TIME$
  774.   IF LEN(Uh.oh$) > 1 THEN TXT$ = Uh.Oh$ + DOOR.NAME$ +  " Date >" + DATE$ + " " + TIME$
  775. CALL PROUT                                             
  776. CLOSE
  777. OPEN "ERRORS.DOR" FOR APPEND AS #4
  778.   PRINT #4, TXT$
  779. CLOSE #4
  780.  
  781. Call Shutdown
  782.  
  783. Chatter:                           '*** F-10 CHAT MODE ***
  784.                                 
  785. SAVETIME = TIME.OFF - TI!       
  786. LINE.SAVE$ = TXT$
  787. NORET = 0
  788. TXT$ = ""
  789. CALL PROUT
  790. CALL PROUT
  791. PRINT "SysOp - Hit ESC to exit chat mode"
  792. TXT$ = "Hello!  This is " + SYSOP.FIRST$ + ","
  793. CALL PROUT
  794.  
  795. Remote:
  796.  
  797. IF Fossil% = False% THEN                                 
  798.   IF LOC(3) = 0 THEN GOTO Local.test
  799.   Chat$ = INPUT$(1, 3)
  800.  ELSE                                                    
  801.   CALL FosReadAhead(Port%, NoChar%)                      
  802.   IF No.Char% = - 1 THEN GOTO Local.Test                 
  803.   FOR m% = 1 TO NoChar%                                  
  804.     CALL FosRXChar(Port%, Char%)                         
  805.     Chat$ = Chat$ + CHR$(Char%)                          
  806.   NEXT m%                                                
  807. END IF                                                   
  808. IF ASC(Chat$) = 8 THEN
  809.   PRINT Bk.Arw$;
  810.   IF Fossil% = False% THEN                               
  811.     PRINT #3, BACK.SP$;
  812.    ELSE                                                  
  813.     Fos$ = BACK.SP$                                      
  814.     Call FsPrOut                                        
  815.   END IF                                                 
  816.  ELSEIF ASC(Chat$) = 27 THEN
  817.   GOTO Local.inp
  818.  ELSE
  819.   PRINT Chat$;
  820.   IF Fossil% = False% THEN                               
  821.     PRINT #3, Chat$;
  822.    ELSE                                                  
  823.     Fos$ = TXT$                                            
  824.     Call FsPrOut                                        
  825.   END IF                                                 
  826. END IF
  827. IF ASC(Chat$) = 13 THEN 
  828.   IF Fossil% = False% THEN                               
  829.     PRINT #3, CHR$(10);
  830.    ELSE                                                  
  831.     Fos$ = CHR$(10)                                      
  832.     Call FsPrOut                                        
  833.   END IF                                                 
  834. END IF
  835. GOTO Remote
  836.  
  837. Local.test:
  838.  
  839. CALL Cartest
  840. Chat$ = INKEY$
  841. IF LEN(Chat$) = 0 THEN GOTO Remote
  842.  
  843. Local.inp:
  844.  
  845. IF ASC(Chat$) = 27 THEN GOTO Chat.end
  846. IF ASC(Chat$) = 8 THEN
  847.   PRINT Bk.Arw$;
  848.   IF Fossil% = False% THEN                               
  849.     PRINT #3, BACK.SP$;
  850.    ELSE                                                  
  851.     Fos$ = BACK.SP$                                      
  852.     Call FsPrOut                                        
  853.   END IF                                                 
  854.  ELSE
  855.   PRINT Chat$;
  856.   IF Fossil% = False% THEN                               
  857.     PRINT #3, Chat$;
  858.    ELSE                                                  
  859.     Fos$ = Chat$                                         
  860.     Call FsPrOut                                        
  861.   END IF                                                 
  862. END IF
  863. IF ASC(Chat$) = 13 THEN 
  864.   IF Fossil% = False% THEN                               
  865.     PRINT #3, CHR$(10);
  866.    ELSE                                                  
  867.     Fos$ = CHR$(10)                                      
  868.     Call FsPrOUt                                        
  869.   END IF                                                 
  870. END IF
  871. GOTO Remote
  872.  
  873. Chat.end:
  874.  
  875. TIME.OFF = TI! + SAVETIME
  876. WARNING = TIME.OFF - (3 * 60)
  877. EndTime! = TI! + 240
  878.   TXT$ = ""
  879.   call PROUT
  880.   ARG$ = ""
  881.   TXT$ = "Chat mode terminated"
  882.   CALL PROUT
  883.   TXT$ = LINE.SAVE$
  884.   CALL PROUT
  885. RETURN
  886.  
  887. Indoor:
  888.  
  889. EC = 0
  890. TIME.OFF = TI! + (NM.TIME * 60)
  891. IF GRP% = 2 THEN GRAPHICS% = 1% ELSE GRAPHICS% = 0
  892. NO.MONITOR = 1
  893. print "Return from Indoor"
  894. RETURN
  895.  
  896. Snoop:
  897.  
  898. IF L.ocal% = True% THEN RETURN
  899. IF NOT Snoop THEN
  900.   LOCATE 24, 1, 1
  901.   PRINT "SNOOP ON"
  902.   CALL LINE25
  903.   Snoop = NOT Snoop
  904.  ELSE LOCATE , , 1
  905.   Snoop = FALSE%
  906.   CLS
  907. END IF
  908. RETURN
  909.  
  910. Forceoff:
  911.  
  912. TIME.NOW.LEFT = INT((TIME.OFF - TI!)/60)
  913. PRINT "Minutes till user forced off? [";TIME.NOW.LEFT;"] ";
  914. INPUT MIN.F.O$
  915. IF MIN.F.O$ = "" THEN RETURN
  916. FORCE.OFF = VAL(MIN.F.O$)
  917. TXT$ = "YOU MUST BE OFF in" + STR$(FORCE.OFF) + " minutes!"
  918. CALL PROUTCR
  919. TXT$ = "Please complete what you are doing within that time"
  920. CALL PROUTCR
  921. TIME.OFF = TI! + (FORCE.OFF * 60)
  922. WARNING = TIME.OFF - (3 * 60)
  923. IF TIME.SAVE < 5 THEN TIME.SAVE = 5
  924. TXT$=""
  925. CALL PROUTCR
  926. ARG$=""
  927. ZX$=""
  928. RETURN
  929.  
  930.  
  931.  
  932. SUB ANSI.COLOR (FC%, BC%, Blink%, high%, L.ocal%) STATIC
  933.  
  934.   IF FC% = BC% THEN
  935.     BC% = 0
  936.     IF FC% = 0 THEN FC% = 7
  937.   END IF
  938.   AC$ = CHR$(27) + "[3"
  939.  
  940. '  set local colors
  941.  
  942.   LFC% = FC%
  943.   IF high% = 1 THEN LFC% = LFC% + 8
  944.   IF Blink% = 1 THEN LFC% = LFC% + 16
  945.   COLOR C.OLOR(LFC%), C.OLOR(BC%)
  946.  
  947. ' see if running locally too
  948.   IF L.ocal% = True% THEN
  949.     Blink% = 0
  950.     high% = 0
  951.     EXIT SUB
  952.   END IF
  953.   REMOTE.ANSI$ = AC$ + MID$(STR$(FC%), 2, 1) + ";4" + MID$(STR$(BC%), 2, 1)    'USER ROUTINE
  954.   IF Blink% = 1 THEN REMOTE.ANSI$ = REMOTE.ANSI$ + ";5"
  955.   IF high% = 1 THEN REMOTE.ANSI$ = REMOTE.ANSI$ + ";1"
  956.   REMOTE.ANSI$ = REMOTE.ANSI$ + "m"
  957.   IF Fossil% = False% THEN                               
  958.     PRINT #3, REMOTE.ANSI$;
  959.    ELSE                                                 
  960.     Fos$ = REMOTE.ANSI$                                  
  961.     Bytes% = LEN(Fos$)                                   
  962.     CALL FosWrite(Port%, Bytes%, Fos$)                   
  963.   END IF                                                 
  964.   Blink% = 0
  965.   high% = 0
  966. END SUB
  967.  
  968. SUB LINE25 STATIC                        
  969.   SHARED FIRST$, LAST$, DOOR.NAME$, RD$, ON.AT$         
  970.   COLOR 11, 1                                           
  971.   LOCATE 25, 1,1                                          
  972.   PRINT FIRST$ + " " + LAST$; TAB(34); DOOR.NAME$; TAB(57); "Node: " + RD$; TAB(70); ON.AT$ + "  ";
  973.   COLOR 7, 0
  974. END SUB
  975.  
  976. SUB NAM.ADJ (NAME$) STATIC
  977.   AX = 0
  978.   FOR LX = 1 TO LEN(NAME$)
  979.     BX = ASC(MID$(NAME$, LX, 1))
  980.     IF AX = 0 AND BX > 96 AND BX < 123 THEN
  981.       MID$(NAME$, LX, 1) = CHR$(BX - 32)
  982.      ELSEIF AX = 1 AND BX > 64 AND BX < 91 THEN
  983.       MID$(NAME$, LX, 1) = CHR$(BX + 32)
  984.     END IF
  985.     AX = 1
  986.     IF BX< 65 OR (BX >90 AND BX< 96) OR BX> 123 THEN AX = 0
  987.   NEXT
  988. END SUB
  989.  
  990. Function TI!
  991.    TI! = CSNG(FIX((VAL(MID$(TIME$, 1, 2)) * 3600) +_
  992.              (VAL(MID$(TIME$, 4, 2)) * 60) +_
  993.              (VAL(MID$(TIME$, 7, 2)) * 1)))
  994. END Function
  995.  
  996. SUB LoadPCBUserInfo
  997. BBS.Type$ = "PC-Board"                        
  998. OPEN "R", 1, MESSAGE.FILE$
  999.   FIELD 1, 128 AS Z$
  1000.   IF PCB14 <> 0 THEN
  1001.     GET 1, 1
  1002.     GRP% = 1
  1003.     BP$ = MID$(Z$, 19, 5)    'BAUD RATE
  1004.     GRP$ =MID$(Z$, 12, 1)
  1005.     IF GRP$ = "Y" THEN
  1006.       GRP% = 2
  1007.     END IF
  1008.     PAR = -1
  1009.     Snoop = VAL(LEFT$(Z$, 2))
  1010.     DOOR.USERS.NAME$= MID$(Z$, 85, 25)
  1011.     exit sub
  1012.   END IF
  1013.   GET 1, 1                      ' PC-Board 12 format
  1014.   BP$ = MID$(Z$, 11, 4)         ' BAUD RATE
  1015.   GRP% = VAL(MID$(Z$, 57, 2))
  1016.   IF GRP% THEN
  1017.     GRP% = 2
  1018.   END IF
  1019.   PAR = -1
  1020.   Snoop = VAL(LEFT$(Z$, 2))
  1021.   DOOR.USERS.NAME$= MID$(Z$,15,27)
  1022. end sub
  1023.  
  1024.  
  1025.  
  1026. SUB LoadWildcatUserInfo 
  1027.     OPEN MESSAGE.FILE$ FOR INPUT AS #1
  1028.     LINE INPUT #1, DOOR.USERS.NAME$
  1029.     IF DOOR.USERS.NAME$ = "Sysop" THEN
  1030.       DOOR.USERS.NAME$ = "SYSOP"
  1031.     END IF
  1032.     DOOR.USERS.NAME$ = DOOR.USERS.NAME$ + "   "
  1033.     LINE INPUT #1, DUMMY$          ' BAUD CODE
  1034.     LINE INPUT #1, DUMMY$          ' CALLING FROM
  1035.     LINE INPUT #1, Security.level$ ' SECURITY LEVEL
  1036.     LINE INPUT #1, DUMMY$          ' TIME REMAINING
  1037.     LINE INPUT #1, DUMMY$
  1038.     GRP% = 1
  1039.     IF LEFT$(DUMMY$,3) = "COL" THEN GRP%=2
  1040.     LINE INPUT #1, DUMMY$          ' PASSWORD
  1041.     LINE INPUT #1, DUMMY$          ' USER REC NUM
  1042.     LINE INPUT #1, DUMMY$          ' MINUTES ONLINE
  1043.     LINE INPUT #1, DUMMY$          ' TIME ENTERED DOOR
  1044.     LINE INPUT #1, DUMMY$          ' TIME CALLED
  1045.     LINE INPUT #1, DUMMY$          ' CONF JOINED
  1046.     LINE INPUT #1, DUMMY$          ' DL FILE TOTL
  1047.     LINE INPUT #1, DUMMY$          ' DAILY DL LIMIT
  1048.     LINE INPUT #1, DUMMY$          ' DL K TOTL
  1049.     LINE INPUT #1, DUMMY$          ' MAX DL LIMIT
  1050.     LINE INPUT #1, DUMMY$          ' USER TELEPH #
  1051.     LINE INPUT #1, DUMMY$          ' TIME/DATE LAST CALL
  1052.     LINE INPUT #1, DUMMY$          ' NOV/EXPERT
  1053.     LINE INPUT #1, DUMMY$          ' PROTOCOL
  1054.     LINE INPUT #1, DUMMY$          ' LAST NEW FILE SEARCH
  1055.     LINE INPUT #1, DUMMY$          ' # SIGNONS
  1056.     LINE INPUT #1, DUMMY$          ' LINES/PAGE
  1057.     LINE INPUT #1, DUMMY$          ' LAST MSG READ
  1058.     LINE INPUT #1, DUMMY$          ' TOTL UPLOAD
  1059.     LINE INPUT #1, DUMMY$          ' TOTL DL
  1060.     LINE INPUT #1, DUMMY$          ' 7 OR 8 BITS
  1061.     PAR = -1
  1062.     IF VAL(DUMMY$) = 7 THEN
  1063.       GRP% = 1 : PAR = 0
  1064.     END IF
  1065.     LINE INPUT #1, LOCAL$          ' LOCAL OR REMOTE
  1066.     LINE INPUT #1, DUMMY$          ' COM PORT
  1067.     LINE INPUT #1, DUMMY$          ' USER BIRTHDATE
  1068.     LINE INPUT #1, BP$             ' USER BAUD RATE
  1069.     IF LEFT$(LOCAL$,3)= "LOC" THEN BP$=LOCAL$
  1070.     Snoop = -1                     'PRESUMABLY ALWAYS ON FOR WILDCAT!
  1071.  
  1072. END SUB
  1073.  
  1074. SUB LoadRBBSUserInfo 
  1075.   OPEN MESSAGE.FILE$ FOR INPUT AS #1
  1076.     LINE INPUT #1, DUMMY$          ' RBBS NAME
  1077.     LINE INPUT #1, DUMMY$          ' SYSOP FIRST
  1078.     LINE INPUT #1, DUMMY$          ' SYSOP LAST
  1079.     LINE INPUT #1, CP$          ' COM PORT
  1080.     LINE INPUT #1, BP$             ' CONNECT 
  1081.    IF CP$="COM0" OR DUMMY$="" THEN BP$="0"
  1082.     LINE INPUT #1, DUMMY$          ' NETWORK TYPE
  1083.     LINE INPUT #1, CFN.X$          ' CALLER FIRST NAME
  1084.     LINE INPUT #1, CLN.X$          ' CALLER LAST NAME
  1085.     LINE INPUT #1, DUMMY$          ' CITY STATE
  1086.     LINE INPUT #1, GRAFX$          ' GRAPHICS PRFERENCE
  1087.     LINE INPUT #1, Security.level$ ' SECURITY LEVEL  
  1088.     LINE INPUT #1, DUMMY$          ' TIME REMAINING
  1089.     DOOR.USERS.NAME$= CFN.X$ + " " + CLN.X$
  1090.     SNOOP = -1                     ' SET ON
  1091.     GRP% = 1
  1092.     IF VAL(GRAFX$)=2 THEN GRP%=2
  1093.     IF VAL(GRAFX$)=1 AND FOR.SURE.RBBS=0 THEN GRP%=2
  1094.     PAR = -1
  1095.     IF INSTR(BP$,"E")>0 THEN PAR = 0
  1096.     BP$ = STR$(VAL(BP$))
  1097.     PRINT "RBBS Complete"
  1098.  
  1099.  
  1100. end SUB
  1101.  
  1102. SUB FSPROUT 
  1103.   Bytes% = LEN(Fos$)                                       
  1104.  
  1105. FOR xxx% =  1 to bytes%
  1106.    foschar% = asc(mid$(Fos$,xxx%,1)) 
  1107. FOSSILTx2:
  1108.    call fostxcharnw(Port%,foschar%,Result%)
  1109.    If Result% = 0 then 
  1110.       CALL GIVEBACK
  1111.       GOTO FOSSILTx2
  1112.    END IF
  1113. next xxx%
  1114.   Call CarTest                                           
  1115. end sub
  1116.  
  1117. SUB CarTest 
  1118. IF L.ocal% = True% THEN exit sub
  1119. IF Fossil% = False% THEN                                  
  1120.   IF INP(MSR) >= 128 THEN exit sub
  1121.  ELSE                                                    
  1122.   CALL FosStatus(Port%, Stat%)                           
  1123.   Stat% = Stat% AND &H0080                               
  1124.   IF Stat% = &H0080 THEN exit sub                          
  1125. END IF                                                   
  1126. IF Snoop THEN PRINT "(**CARRIER DROPPED**)"
  1127.  
  1128. CLOSE
  1129. IF Fossil% = False% THEN            
  1130.   OUT MCR, INP(MCR) OR 1
  1131.  ELSE                                                    
  1132.   CALL FosExit(Port%)                                    
  1133. END IF                                                   
  1134. call shutdown
  1135. end sub
  1136.  
  1137. SUB PROUTCR
  1138.   lfeed = 1
  1139.   call prout
  1140.   lfeed = 0
  1141. end sub
  1142.  
  1143.  
  1144. SUB PROUT 
  1145. OUT.PUT:
  1146. IF GRAPHICS% = 1 THEN CALL ANSI.COLOR(FC%, BC%, Blink%, high%, L.ocal%)
  1147.  
  1148. Out.put1:
  1149.  
  1150. IF L.ocal% = True% or Snoop THEN
  1151.  
  1152. select case lfeed 
  1153.   case 0
  1154.       IF Row% <> 0 AND Col% <> 0 THEN
  1155.             LOCATE Row%, Col%,1
  1156.             PRINT TXT$;
  1157.           ELSE
  1158.             PRINT TXT$;
  1159.          END IF
  1160.   case else ' (Carriage return wanted)
  1161.       IF Row% <> 0 AND Col% <> 0 THEN
  1162.             LOCATE Row%, Col%,1
  1163.             PRINT TXT$
  1164.           ELSE
  1165.             PRINT TXT$
  1166.          END IF
  1167. end select
  1168.  
  1169.  
  1170. end if  ' (L.ocal% = True% or SNOOP)
  1171.  
  1172. IF L.ocal% = True% THEN GOTO Chk.line
  1173. IF Row% <> 0 AND Col% <> 0 THEN
  1174.   Row$ = STR$(Row%) : Row$ = MID$(Row$, 2, LEN(Row$) -1)
  1175.   Col$ = STR$(Col%) : Col$ = MID$(Col$, 2, LEN(Col$) -1)
  1176.   Cursor$ = CHR$(27)+ "[" + Row$ + ";" + Col$ + "H"
  1177.   IF Fossil% = False% THEN                                
  1178.     PRINT #3, Cursor$;
  1179.     PRINT #3, TXT$;
  1180.    ELSE                                                  
  1181.     Fos$ = Cursor$                                       
  1182.     Call FsPrOut                                        
  1183.     Fos$ = TXT$                                           
  1184.     Call FsPrOut                                        
  1185.   END IF                                                 
  1186.  ELSE                                                   
  1187.   IF Fossil% = False% THEN                               
  1188.     PRINT #3, TXT$;
  1189.    ELSE                                                  
  1190.     Fos$ = TXT$                                           
  1191.     Call FsPrOut                                        
  1192.   END IF                                                 
  1193. END IF
  1194. '
  1195. ' The following section should only be used if you desire to reset the
  1196. ' colors back to Color.Normal$ (as defined in the beginning of the
  1197. ' program) after each screen write.  This usually isn't needed.  
  1198. ' 
  1199. '
  1200. 'IF GRAPHICS% = 1 THEN 
  1201. '  IF Fossil% = False% THEN                               
  1202. '    PRINT #3, COLOR.NORMAL$;
  1203. '   ELSE                                                  
  1204. '    Fos$ = COLOR.NORMAL$                                 
  1205. '    Call FsPrOut                                        
  1206. '  END IF                                                 
  1207. 'END IF
  1208.  
  1209. IF LFEED = 1 THEN 
  1210.   IF Fossil% = False% THEN                               
  1211.     PRINT #3, LF$;
  1212.    ELSE                                                  
  1213.     Fos$ = LF$                                           
  1214.     Call FsPrOut                                        
  1215.   END IF                                                 
  1216. END IF
  1217.  
  1218. CALL Cartest
  1219.  
  1220.  
  1221.  
  1222. Chk.line:
  1223.  
  1224. GOSUB Check.time4
  1225. GOSUB Check.time3
  1226. NORET = 0
  1227. row% = 0:col% = 0
  1228. EXIT SUB
  1229.  
  1230. 'Exit.door:
  1231. Call Shutdown
  1232.  
  1233. END
  1234.  
  1235. Call OutOfTime
  1236.  
  1237. Check.time4:
  1238.  
  1239. WARNING = TIME.OFF - 180
  1240. IF TI! > WARNING AND T.IMER = 1 THEN
  1241.   IF INT((TIME.OFF - TI!) / 60) < TIME.SAVE THEN
  1242.     WARNING = WARNING + 60
  1243.     TXT$ = "** YOU HAVE" + STR$(INT((TIME.OFF - TI!) / 60)) + " MINUTES REMAINING!! **"
  1244.     IF L.ocal% <> True% THEN 
  1245.       IF Fossil% = False% THEN                           
  1246.         PRINT #3, CHR$(7)
  1247.        ELSE                                              
  1248.         Fos$ = CHR$(7)                                   
  1249.         Call FsPrOut                                    
  1250.       END IF                                             
  1251.     END IF
  1252.     GOSUB OUT.PUT
  1253.     TIME.SAVE = INT((TIME.OFF - TI!) / 60)
  1254.     T.IMER = 0
  1255.     RETURN
  1256.   END IF
  1257. END IF
  1258. RETURN
  1259.  
  1260. Check.time3:
  1261.  
  1262. IF TI! > TIME.OFF THEN
  1263.   TXT$ = "TIME LIMIT EXCEEDED! +"
  1264.   call shutdown
  1265. END IF
  1266. RETURN
  1267.  
  1268. end sub
  1269.  
  1270. SUB OutOfTime
  1271.    TXT$ = "Time has expired!!!!" : 
  1272.   IF Fossil% = False% THEN                                 
  1273.     PRINT #3, TXT$ 
  1274.    ELSE                                                    
  1275.     Fos$ = TXT$                                              
  1276.    Call FsPrOut                                          
  1277.   END IF                                                   
  1278. PRINT TXT$
  1279. 'Call Delay (2)
  1280. Call Shutdown
  1281. End Sub
  1282.  
  1283. sub Shutdown
  1284.  
  1285. ' This is used for normal exits as well as fatal door crashes.
  1286. ' Something could be wrong at this point, (loss of carrier,
  1287. ' hardrive full, or whatever).
  1288. ' Many users that only use your board to run the doors,
  1289. ' hangup immediately after they are finished with the door.
  1290. ' Many will break connection right as they hit the [Q]uit key.
  1291. ' This will also cause a problem.
  1292. '  Therefore, the object of this subprogram  is to 
  1293. '  close files in priority order, and get out quickly.
  1294.  
  1295. ' If another error occurs anywhere in this process, then
  1296. ' the error routine will be recursivley called.
  1297. ' but this time, Error.Flag% will be true, which will
  1298. ' force the door to end.
  1299.  
  1300.  
  1301. ' First, attempt to update and/or close all data files related
  1302. ' to this door.  In a normal door end, this all works very well.
  1303. ' When I close databases and indices, I force closure.
  1304. ' If you have datafiles, and have the expertise, you should consider
  1305. ' opening them in a "writethrough" vice buffered mode.  This could
  1306. ' save your data as well.
  1307.  
  1308.  
  1309.  
  1310.  
  1311.  
  1312.  
  1313. ' Lastly, announce to the user that the show's over...
  1314. ' If he/she doesn't get to this point, that's okay.
  1315. ' All datafiles have been closed, and the door will gracefully
  1316. ' return to the bat file from which it was called.
  1317.  
  1318.  
  1319. TXT$ = "Returning to the board." 
  1320. IF Fossil% = False% THEN                                 
  1321.   PRINT #3, TXT$ 
  1322.  ELSE                                                    
  1323.   Fos$ = TXT$                                              
  1324.   Call FsPrOut
  1325. END IF
  1326.  
  1327. call exitdoor
  1328.  
  1329. end sub
  1330.  
  1331.  
  1332. SUB InputLine
  1333.  
  1334. TXT$ = ""
  1335. ARG$ = ""
  1336. Escape% = False%
  1337. Ansi.Command.Next% = False%
  1338. Up% = False%:Down% = False%: Left% = False%:Right% = False%
  1339. P.LINE = 0
  1340. NOFSX$ = ""
  1341. EndTime! = TI! + (VAL(LOG.OFF$) * 60)
  1342.  
  1343. InputLineStart:                                   ' Idle user check
  1344. IF TI! > EndTime! AND L.ocal% <> True% THEN
  1345.   TXT$="NO INPUT IN "+LOG.OFF$+" MINUTES! YOU'RE LOGGED OFF!"
  1346.   CALL PROUTCR
  1347.   CALL OutOfTime
  1348. END IF
  1349. CALL Cartest
  1350. TXT$ = INKEY$
  1351.  
  1352. 'Always check for Sysop Console Input First, if none found, then
  1353. ' check comport for user input
  1354. IF TXT$ = "" THEN 
  1355.    IF L.ocal% <> True% THEN 
  1356.      IF Fossil% = False% THEN                               
  1357.           IF NOT (EOF(3)) THEN                                 
  1358.             TXT$ = INPUT$(1, 3)
  1359.           END IF                                               
  1360.        ELSE                                                  
  1361.          CALL FosReadAhead(Port%, Char%)                      
  1362.          IF Char% <> -1 THEN                                   
  1363.             CALL FosRXChar(Port%, Char%)                       
  1364.             TXT$ = CHR$(Char%)                                   
  1365.          END IF   ' (IF CHAR% = -1) 
  1366.       END IF 'IF Fossil% = False%                                     
  1367.    END IF 'IF L.ocal% = True%
  1368. END IF ' IF TXT$ = ""
  1369. ' 
  1370.  
  1371. ' Check to see if this is a single character call
  1372.  
  1373. ' First Check for Cursor Keys
  1374.  
  1375. If SingleChar% AND Txt$ = ESC$ then
  1376.    Escape% = True%
  1377.    goto InputLineStart
  1378. End if
  1379.  
  1380. If Escape% and Txt$ = Ansi.Command$ then
  1381.    Ansi.Command.Next% = True%
  1382.    Goto InputLineStart 
  1383. End if
  1384.  
  1385. If Ansi.Command.Next% then
  1386.  
  1387. select case Txt$
  1388.  
  1389.     case Chr$(68)
  1390.       Left% = True% 
  1391.       Exit Sub
  1392.     case CHR$(67)
  1393.        Right% = True%
  1394.        Exit Sub
  1395.     case CHR$(65)
  1396.        Up% = True%
  1397.        Exit Sub 
  1398.     case CHR$(66)
  1399.        Down% = True%
  1400.        Exit Sub 
  1401.     ' If you wanted too, this would be the place to trap other
  1402.     ' ANSI Commands
  1403.     case else
  1404. end select
  1405. end if ' (Ansi.Command.Next%)
  1406.  
  1407. if SingleChar% = True% AND Txt$ <> "" Then
  1408.    SingleChar% = False%
  1409.    Arg$ = Txt$
  1410.    Exit Sub
  1411. End if                                           
  1412.  
  1413.  
  1414.  
  1415. 'Check to see if user enter a carriage return
  1416. IF TXT$ = CR$ THEN
  1417.   Arg$ = Txt$
  1418.   EXIT SUB
  1419. END IF
  1420.  
  1421.  
  1422.  
  1423.  
  1424.  
  1425.  
  1426. ' list all of your special keys such as backspace and 
  1427. ' tab prior in this area
  1428. IF TXT$ = CHR$(8) OR TXT$ = CHR$(7) THEN GOTO SpecialKeys
  1429.  
  1430. ' Once you have indicated all the special keys that you want
  1431. ' to flag then this line rejects all others.
  1432. ' if you are having line noise problems with the door and
  1433. ' your door will not be used by users with the international
  1434. ' character set, then change the following line  to
  1435.  
  1436. 'IF TXT$ < CHR$(32) or TXT$ > (128) THEN GOTO InputLineStart 
  1437.  
  1438.  IF TXT$ < CHR$(32) THEN GOTO InputLineStart
  1439.  
  1440. IF L.ocal% = True% OR  Snoop THEN
  1441.    PRINT TXT$;
  1442. end if
  1443.  
  1444. IF L.ocal% <>  True% THEN
  1445.    IF Fossil% = False% THEN                                 
  1446.        PRINT #3, TXT$;                                         
  1447.     ELSE                                                    
  1448.        Fos$ = TXT$                                              
  1449.        Call FsPrOut                                          
  1450.     END IF
  1451. end if 
  1452.  
  1453. CALL Cartest
  1454. GOTO InputLineStart
  1455.  
  1456. SpecialKeys:                                       ' Backspace
  1457.  
  1458. IF LEN(ARG$) = 0 THEN GOTO InputLineStart
  1459. ARG$ = LEFT$(ARG$, LEN(ARG$) - 1)
  1460. PRINT Bk.Arw$;
  1461. IF L.ocal% = True% THEN GOTO InputLineStart
  1462. IF Fossil% = False% THEN                                 
  1463.   PRINT #3, BACK.SP$;
  1464.  ELSE                                                    
  1465.   Fos$ = BACK.SP$                                        
  1466.   Call FsPrOut                                          
  1467. END IF                                                   
  1468. GOTO InputLineStart
  1469.  
  1470. NORET = 0
  1471. EXIT SUB
  1472.  
  1473.  
  1474. END SUB '(InputLine)
  1475.  
  1476.  
  1477. SUB ExitDoor
  1478.  
  1479. call clrScreen 
  1480. row% = 3:col% =22 :TXT$ = "┌───────────────────────────────────┐":call proutcr
  1481. row% = 4:col% =22 :TXT$ = "│                                   │":call proutcr
  1482. row% = 5:col% =22 :TXT$ = "│     This has been a TechnoWare    │":call proutcr
  1483. row% = 6:col% =22 :TXT$ = "│     Demonstration of MakeDoor     │":call proutcr
  1484. row% = 7:col% =22 :TXT$ = "│                                   │":call proutcr
  1485. row% = 8:col% =22 :TXT$ = "│                                   │":call proutcr
  1486. row% = 9:col% =22 :TXT$ = "│     For the latest version of     │":call proutcr
  1487. row% =10:col% =22 :TXT$ = "│      MakeDoor, please call:       │":call proutcr
  1488. row% =11:col% =22 :TXT$ = "│                                   │":call proutcr
  1489. row% =12:col% =22 :TXT$ = "│     Technopeasants' East BBS      │":call proutcr
  1490. row% =13:col% =22 :TXT$ = "│  (301)-927-4258 (PC Pursuitable)  │":call proutcr
  1491. row% =14:col% =22 :TXT$ = "└───────────────────────────────────┘":call proutcr
  1492. 'call delay(2)
  1493. row% = 22:col% = 1:TXT$ = "Returning to "+RBBS.NAME$
  1494. CALL PROUTCR
  1495. CLOSE
  1496. END
  1497.  
  1498. END SUB '(ExitDoor)
  1499.  
  1500. SUB InputChar
  1501. SingleChar% = True%
  1502. Call InputLine
  1503. END SUB
  1504.  
  1505. SUB InputField(Field$)
  1506. TabKey% = FALSE%
  1507. BACKTAB% = FALSE%
  1508. homerow% = csrlin
  1509. homecol% = pos(0)
  1510. 'row% = homerow%:col% = homecol%
  1511. LengthField% = Len(field$)
  1512.  
  1513. for x% = 1 to LengthField%
  1514.  
  1515.   BeginFieldInput:
  1516.   Call InputChar
  1517.    
  1518.  ' NEXT Yy%
  1519.  
  1520.   ' *** LEFT CURSOR KEY INPUT  (OR BACKSPACE KEY)
  1521.   ' after InputChar gets a keystroke, it advances
  1522.   ' the cursor one, so to move back one character
  1523.   ' we have to substract two from current cursor position
  1524.   ' The Next x% at the bottom will advance the character 
  1525.   ' pointer so we also need to subtract two from it
  1526.   '  Left% IS check for remote cursor, while the rest is check for
  1527.   '                                    local cursor key
  1528.   if Left% OR (arg$ = BACKSPACE$ OR (len(arg$) > 1 and Mid$(arg$,2,1) = "K"))  then
  1529.      if x% > 1 then
  1530.        'move the character pointer in the string
  1531.        x% = x% - 2
  1532.        ' reposition the cursor
  1533.        ' move it on the local screen
  1534.        col% = col% - 2
  1535.        goto positioncursor
  1536.       end if
  1537.    end if
  1538.  
  1539.  
  1540.   '  *** RIGHT CURSOR INPUT
  1541.   ' after InputChar gets a keystroke, it advances
  1542.   ' the cursor one, so for a right cursor, we shouldn't
  1543.   ' have to do anything
  1544.   ' Check for Right Cursor Key
  1545.   
  1546.    
  1547.   if Right% OR (len(arg$) > 1 and Mid$(arg$,2,1) = "M")  then
  1548.      if x% < LengthField% then
  1549.         goto positioncursor    
  1550.      end if
  1551.   end if
  1552.   ' *** TAB 
  1553.  
  1554.   if Down% = TRUE% or arg$ = TABKEY$ THEN
  1555.       TabKey% = TRUE%
  1556.       x% = lengthfield% + 1
  1557.       goto LoopField
  1558.   end if
  1559.   ' *** BACKTAB
  1560.       if UP% = TRUE% or (len(arg$) > 1 and asc(mid$(arg$,2,1)) = 15)  then
  1561.         BACKTAB% = TRUE%
  1562.       x% = lengthfield% + 1
  1563.       goto LoopField
  1564.   end if
  1565.   ' *** CARRIAGE RETURN
  1566.    if arg$ = cr$ then
  1567.       x% = lengthfield% + 1
  1568.       goto LoopField
  1569.    end if
  1570.    ' NOW REJECT ALL OTHER ASCII CODES NOT WANTED PRIOR TO 
  1571.    ' SCREEN DISPLAY
  1572.    if len(ARG$) > 1 then goto BEGINFIELDINPUT
  1573.    if asc(arg$) < 32 then goto BEGINFIELDINPUT
  1574.  
  1575.   ' print the field again after each loop
  1576.     mid$(Field$,x%,1)  = arg$: row% = homerow%:col% = homecol% + (x%-1)
  1577.     txt$ = Mid$(Field$,x%,1):call prout
  1578.     positioncursor:
  1579.     row% = homerow%:col% = homecol%+ (x%-1)
  1580.     'locate row%,col%,1
  1581.     call MoveCursor(row%,Col%+1)
  1582.   LoopField:
  1583. Next x%
  1584.  
  1585. END SUB
  1586.  
  1587. sub MoveCursor(r%,c%)
  1588.   row% = r%:col% = c%:txt$="":call prout
  1589. end sub
  1590.  
  1591. Sub ClrScreen              
  1592. Filename$ = "Clear Screen"
  1593. Clear$ = CHR$(27) + "[2J"         
  1594.  CALL  CARTEST                    
  1595. IF L.ocal% <> True% THEN                  
  1596.   IF Fossil% = False% THEN        
  1597.     PRINT #3, Clear$              
  1598.    ELSE                           
  1599.     Fos$ = Clear$                 
  1600.     Call FsPrOut                 
  1601.   END IF                          
  1602. END IF
  1603. IF L.ocal% = True% OR SNOOP THEN       
  1604.   CLS 
  1605.   CALL LINE25                     
  1606. END IF                            
  1607. end sub
  1608.  
  1609.